home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TCYBER25 / CYGAME.ZIP / CYGAME.PAS < prev    next >
Pascal/Delphi Source File  |  1994-10-20  |  29KB  |  1,137 lines

  1. {
  2. Turbo Vision CyberTools 2.5
  3. (C) 1994 Steve Goldsmith
  4. All Rights Reserved
  5.  
  6. CyberGame application shows how to use character sprites in a multi-level
  7. 'Invaders' type arcade game.
  8.  
  9. Borland Pascal 7.x or Turbo Pascal 7.x and Turbo Vision 2.x are required to
  10. compile.
  11.  
  12. Set IDE directories to
  13.  
  14. \BP\UNITS;
  15. \BP\EXAMPLES\DOS\TVDEMO;
  16. \BP\EXAMPLES\DOS\TVFM;
  17.  
  18. These path names are BP 7.x defaults.  If you changed any of these then use
  19. the correct paths in Options|Directories...  See APP.INC for global compiler
  20. switches.
  21. }
  22.  
  23. program CyberGame;
  24.  
  25. {$I APP.INC}
  26. {$X+}
  27.  
  28. uses
  29.  
  30.   Dos,                           {bp units}
  31.   Memory, Drivers, Objects,      {tv units}
  32.   Views, Menus, Dialogs,
  33.   App, MsgBox, StdDlg, ColorSel,
  34.   Gadgets, HelpFile,             {tvdemo units}
  35.   ViewText,                      {tvfm units}
  36.   CGHelp, CGCmds,                {cybertools units}
  37.   VGA, VGACGFil, GameDlg, PCX,
  38.   CommDlgs, TVStr;
  39.  
  40. const
  41.  
  42.   appDocName  = 'CYBER.DOC';  {doc file name}
  43.   appCfgName  = 'CYGAME.CFG'; {config stream file name}
  44.   appHelpName = 'CGHELP.HLP'; {help file name}
  45.   appExeName  = 'CYGAME.EXE'; {name used to locate .exe for older dos}
  46.   appCfgHeaderLen = 10;       {header used by config stream}
  47.   appCfgHeader : string[appCfgHeaderLen] = 'CYBERGAME'#26;
  48.   appViewDocBuf = 8192;       {buffer size for viewing doc file}
  49.  
  50.   appChrWidth8  = $01;        {set app options bit to 1 to select option}
  51.   appPageMode   = $02;
  52.   app8Colors    = $04;
  53.   appHelpInUse  = $8000;      {used by help system}
  54.   appScrOpts    = $07;        {mask of just screen options}
  55.  
  56.   appGraphWinX = 32;          {x = 32*8 = 256 pixels}
  57.   appGraphWinY = 8;           {y = 8*16 = 128 pixels}
  58.   appFadeInc   = 8;           {fade in/out increment}
  59.  
  60.   CSysColor = #$00#$00#$00;   {app palette additions for tv system stuff}
  61.   CSysPal   = #144#145#146;
  62.  
  63. type
  64.  
  65.   TCyberGame = object (TApplication)
  66.     FontTable1,
  67.     FontTable2,
  68.     FirstChr,
  69.     LastChr : byte;
  70.     AppOptions,
  71.     PageOfs,
  72.     DefChrHeight : word;
  73.     Page : pointer;
  74.     DefFont : vgaChrTablePtr;
  75.     DacPalette : vgaPalette;
  76.     ScrData : ScrOptsData;
  77.     CtlData : GameOptsData;
  78.     Clock : PClockView;
  79.     Heap : PHeapView;
  80.     constructor Init;
  81.     destructor Done; virtual;
  82.     procedure SetCustomScreen;
  83.     procedure FlipPage;
  84.     procedure ClearDeskTop;
  85.     procedure Idle; virtual;
  86.     procedure AboutBox;
  87.     procedure LoadFontTable (ChrData : pointer;
  88.                              ChrTable, ChrHeight :byte;
  89.                              StartChr, NumChrs : word);
  90.     function SaveFontTable (ChrTable, ChrHeight :byte;
  91.                             StartChr, NumChrs : word) : vgaChrTablePtr;
  92.     procedure RestoreDesktop (F : PathStr);
  93.     procedure SaveDeskTop (F : PathStr);
  94.     procedure GetEvent (var Event : TEvent); virtual;
  95.     function GetPalette : PPalette; virtual;
  96.     procedure HandleEvent (var Event : TEvent); virtual;
  97.     procedure InitDeskTop; virtual;
  98.     procedure InitMenuBar; virtual;
  99.     procedure InitStatusLine; virtual;
  100.     procedure OutOfMemory; virtual;
  101.     procedure LoadDesktop (var S : TStream);
  102.     procedure StoreDesktop (var S : TStream);
  103.   end;
  104.  
  105. {
  106. Initilize TV app.
  107. }
  108.  
  109. constructor TCyberGame.Init;
  110.  
  111. var
  112.  
  113.   R :TRect;
  114.  
  115. begin
  116.   LowMemSize := 512;    {8192 byte safety pool}
  117.   inherited Init;
  118.   RegisterObjects;      {register stuff for stream access}
  119.   RegisterViews;
  120.   RegisterMenus;
  121.   RegisterDialogs;
  122.   RegisterApp;
  123.   RegisterHelpFile;
  124.  
  125.   GetExtent (R);   {gadgets included with tvdemo}
  126.   R.A.Y := R.B.Y-1;
  127.   R.B.X := R.B.X-1;
  128.   R.A.X := R.B.X-8;
  129.   Heap := New (PHeapView,Init(R));
  130.   Heap^.GrowMode := gfGrowAll;
  131.   Insert (Heap);
  132.  
  133.   GetExtent (R);
  134.   R.B.Y := R.A.Y+1;
  135.   R.B.X := R.B.X-1;
  136.   R.A.X := R.B.X-8;
  137.   Clock := New (PClockView,Init (R));
  138.   Insert (Clock);
  139.  
  140.   RestoreDesktop (appCfgName); {load config stream}
  141.   AboutBox;
  142.   Randomize                    {animation dialogs use random numbers}
  143. end;
  144.  
  145. {
  146. Done TV app.
  147. }
  148.  
  149. destructor TCyberGame.Done;
  150.  
  151. begin
  152.   ClearDeskTop;               {make sure all games closed}
  153.   if DefFont <> nil then      {dispose default font}
  154.     FreeMem (DefFont,vgaMaxChrs*DefChrHeight);
  155.   FadeOutDAC (appFadeInc);    {fade to black}
  156.   SetVideoMode (StartUpMode); {this resets all the custom stuff with bios}
  157.   inherited Done
  158. end;
  159.  
  160. {
  161. Sets screen page if not not flipping, 8 or 16 color mode, 8 or 9 pixel width,
  162. font map, DAC palette and mouse mask.
  163. }
  164.  
  165. procedure TCyberGame.SetCustomScreen;
  166.  
  167. begin
  168.   HideMouse;
  169.   if AppOptions and appPageMode = 0 then
  170.     SetPage (vgaPageOfsLoc[0]); {screen page 0 for non page flipping displays}
  171.   if AppOptions and app8Colors = app8Colors then
  172.     SetAttrCont (vgaAttrCPEnable,$07)  {use 8 colors}
  173.   else
  174.     SetAttrCont (vgaAttrCPEnable,$0f); {use 16 colors}
  175.   if AppOptions and appChrWidth8 = appChrWidth8 then
  176.   begin
  177.     if IsChrWidth9 then
  178.       SetChrWidth8 {640 x 400 screen}
  179.   end
  180.   else
  181.   begin
  182.     if not IsChrWidth9 then
  183.       SetChrWidth9 {720 x 400 screen}
  184.   end;
  185.   FontMapSelect (vgaChrTableMap1[FontTable1],
  186.   vgaChrTableMap2[FontTable2]);    {select font tables}
  187.   SetDACBlock (@DacPalette,0,256); {set 256 color palette}
  188.   MouseTextMask ($ffff,$f700);     {set mouse mask for both fonts}
  189.   ShowMouse
  190. end;
  191.  
  192. {
  193. Copy screen page 0 to new non-visiable page and flip to new page.
  194. }
  195.  
  196. procedure TCyberGame.FlipPage;
  197.  
  198. begin
  199.   CopyScrMem (ScreenBuffer,Page,vgaScrSize25);
  200.   SetPage (PageOfs);
  201.   if PageOfs = vgaPageOfsLoc[1] then
  202.   begin
  203.     PageOfs := vgaPageOfsLoc[2];
  204.     Page := vgaPageLoc[2]
  205.   end
  206.   else
  207.   begin
  208.     PageOfs := vgaPageOfsLoc[1];
  209.     Page := vgaPageLoc[1]
  210.   end;
  211.   WaitVertSync {wait for vga vert sync before drawing anything}
  212. end;
  213.  
  214. {
  215. Remove all closeable windows from desk top.
  216. }
  217.  
  218. procedure TCyberGame.ClearDeskTop;
  219.  
  220. procedure CloseDlg (P : PView); far;
  221.  
  222. begin
  223.   Message (P,evCommand,cmClose,nil)
  224. end;
  225.  
  226. begin
  227.   Desktop^.ForEach (@CloseDlg)
  228. end;
  229.  
  230. {
  231. Handle app's idle time processing.
  232. }
  233.  
  234. procedure TCyberGame.Idle;
  235.  
  236. {return true if any view on desk top is tileable}
  237.  
  238. function IsTileable (P : PView) : boolean; far;
  239.  
  240. begin
  241.   IsTileable := (P^.Options and ofTileable <> 0) and
  242.   (P^.State and sfVisible <> 0)
  243. end;
  244.  
  245. begin
  246.   inherited Idle;
  247.   Clock^.Update; {update tvdemo gadgets}
  248.   Heap^.Update;
  249.   if Desktop^.Current <> nil then              {see if anything is}
  250.   begin                                        {on the desk top}
  251.     EnableCommands ([cmCloseAll]);
  252.     if Desktop^.FirstThat (@IsTileable) <> nil then {see if any tileable}
  253.       EnableCommands ([cmTile,cmCascade])           {windows are on the}
  254.     else                                            {desk top}
  255.       DisableCommands ([cmTile,cmCascade]);
  256.     Message (DeskTop,evBroadcast,cmAnimate,nil) {update all animation dialogs}
  257.   end
  258.   else
  259.     DisableCommands ([cmCloseAll,cmTile,cmCascade]);
  260.   if ((Desktop^.Current <> nil) and
  261.   (Desktop^.Current^.State and sfModal = sfModal)) or
  262.   (AppOptions and appHelpInUse = appHelpInUse) then    {see if modal dialog}
  263.     DisableCommands ([cmQuit])                         {is on the desk top}
  264.   else
  265.     EnableCommands ([cmQuit]);
  266.   if AppOptions and appPageMode = appPageMode then
  267.     FlipPage  {if page mode is enabled then flip page each idle cycle}
  268. end;
  269.  
  270. {
  271. Display info about app.
  272. }
  273.  
  274. procedure TCyberGame.AboutBox;
  275.  
  276. begin
  277.   HelpCtx := hcAbout;
  278.   MessageBox(
  279.     #3'Turbo Vision CyberTools 2.5'#13+
  280.     #3'(C) 1994 Steve Goldsmith'#13+
  281. {$IFDEF DPMI}
  282.     #3'CyberGame DPMI',
  283. {$ELSE}
  284.     #3'CyberGame REAL',
  285. {$ENDIF}
  286.     nil, mfInformation or mfOKButton);
  287.   HelpCtx := hcNoContext
  288. end;
  289.  
  290. {
  291. Load font table from system RAM.
  292. }
  293.  
  294. procedure TCyberGame.LoadFontTable (ChrData : pointer;
  295.                                     ChrTable, ChrHeight :byte;
  296.                                     StartChr, NumChrs : word);
  297.  
  298. begin
  299.   HideMouse;
  300.   AccessFontMem;
  301.   SetRamTable (StartChr,NumChrs,ChrHeight,ChrData,vgaChrTableLoc[ChrTable]);
  302.   AccessScreenMem;
  303.   ShowMouse
  304. end;
  305.  
  306. {
  307. Save font table from video RAM.
  308. }
  309.  
  310. function TCyberGame.SaveFontTable (ChrTable, ChrHeight :byte;
  311.                                    StartChr, NumChrs : word) : vgaChrTablePtr;
  312.  
  313. begin
  314.   HideMouse;
  315.   AccessFontMem;
  316.   SaveFontTable :=
  317.   GetRamTable (StartChr,NumChrs,ChrHeight,vgaChrTableLoc [ChrTable]);
  318.   AccessScreenMem;
  319.   ShowMouse
  320. end;
  321.  
  322. {
  323. Restore desk top stream.
  324. }
  325.  
  326. procedure TCyberGame.RestoreDesktop (F : PathStr);
  327.  
  328. var
  329.  
  330.   I : byte;
  331.   S : PStream;
  332.   Signature : string[appCfgHeaderLen];
  333.  
  334. begin
  335.   S := New (PBufStream,Init (F,stOpenRead,1024));
  336.   if LowMemory then OutOfMemory
  337.   else
  338.     if S^.Status <> stOk then
  339.     begin
  340.       MessageBox (#3'Unable to open file.',nil,mfOkButton+mfError)
  341.     end
  342.     else
  343.     begin
  344.       Signature[0] := Char (appCfgHeaderLen);
  345.       S^.Read (Signature[1],appCfgHeaderLen);
  346.       if Signature = appCfgHeader then {see if signature is right}
  347.       begin
  348.         S^.Read (AppOptions,SizeOf (AppOptions)); {read data from stream}
  349.         S^.Read (CtlData,SizeOf (CtlData));
  350.         S^.Read (FontTable1,SizeOf (FontTable1));
  351.         S^.Read (FontTable2,SizeOf (FontTable2));
  352.         S^.Read (FirstChr,SizeOf (FirstChr));
  353.         S^.Read (LastChr,SizeOf (LastChr));
  354.         S^.Read (DacPalette,SizeOf (DacPalette));
  355.  
  356.         if DefFont = nil then
  357.           DefFont := MemAlloc (DefChrHeight*vgaMaxChrs);
  358.         HideMouse; {no screen writes during font mem access}
  359.         AccessFontMem;
  360.         for I := 0 to 7 do
  361.         begin
  362.           S^.Read (DefFont^,DefChrHeight*vgaMaxChrs);
  363.           SetRamTable (0,vgaMaxChrs,DefChrHeight,DefFont,vgaChrTableLoc[I])
  364.         end;
  365.         AccessScreenMem;
  366.         ShowMouse;
  367.         LoadDesktop (S^);
  368.         LoadIndexes (S^);
  369.         ShadowAttr := GetColor (144);   {tv shadow color}
  370.         SysColorAttr := (GetColor (145) shl 8) or GetColor (145); {tv system error color}
  371.         ErrorAttr := GetColor (146);    {tv palette index error color}
  372.         Application^.ReDraw; {draw app with new config}
  373.         if DefFont <> nil then
  374.         begin
  375.           FreeMem (DefFont,DefChrHeight*vgaMaxChrs);
  376.           DefFont := SaveFontTable (FontTable1,DefChrHeight,0,vgaMaxChrs)
  377.         end;
  378.         SetCustomScreen;
  379.         if S^.Status <> stOk then
  380.           MessageBox (#3'Stream error.',nil,mfOkButton+mfError);
  381.       end
  382.       else
  383.         MessageBox (#3'Invalid configuration format.',nil,mfOkButton+mfError)
  384.     end;
  385.   Dispose (S,Done)
  386. end;
  387.  
  388. {
  389. Save desk top stream.
  390. }
  391.  
  392. procedure TCyberGame.SaveDesktop (F : PathStr);
  393.  
  394. var
  395.  
  396.   I : byte;
  397.   CfgFile : File;
  398.   S : PStream;
  399.   SFont : vgaChrTablePtr;
  400.  
  401. begin
  402.   S := New(PBufStream,Init (F,stCreate,1024));
  403.   if not LowMemory and (S^.Status = stOk) then
  404.   begin
  405.     S^.Write (appCfgHeader[1],appCfgHeaderLen);
  406.     S^.Write (AppOptions,SizeOf (AppOptions));
  407.     S^.Write (CtlData,SizeOf (CtlData));
  408.     S^.Write (FontTable1,SizeOf (FontTable1));
  409.     S^.Write (FontTable2,SizeOf (FontTable2));
  410.     S^.Write (FirstChr,SizeOf (FirstChr));
  411.     S^.Write (LastChr,SizeOf (LastChr));
  412.     GetDACBlock (@DacPalette,0,256);
  413.     S^.Write(DacPalette,SizeOf (DacPalette));
  414.  
  415.     HideMouse; {no screen write during font mem access}
  416.     AccessFontMem;
  417.     for I := 0 to 7 do {save all 8 vga font tables}
  418.     begin
  419.       SFont := GetRamTable (0,vgaMaxChrs,DefChrHeight,vgaChrTableLoc[I]);
  420.       S^.Write (SFont^,DefChrHeight*vgaMaxChrs);
  421.       if SFont <> nil then
  422.         FreeMem (SFont,DefChrHeight*vgaMaxChrs)
  423.     end;
  424.     AccessScreenMem;
  425.     ShowMouse;
  426.  
  427.     StoreDesktop (S^);
  428.     StoreIndexes (S^);
  429.     if S^.Status <> stOk then
  430.     begin {if stream error then delete file}
  431.       MessageBox (#3'Could not create stream.',nil,mfOkButton+mfError);
  432.       Dispose (S,Done);
  433.       Assign (CfgFile,F);
  434.       {$I-} Erase (CfgFile) {$I+};
  435.       Exit
  436.     end
  437.   end;
  438.   Dispose (S,Done)
  439. end;
  440.  
  441. {
  442. Intercept cmHelp to display help even when views are in modal state.
  443. }
  444.  
  445. procedure TCyberGame.GetEvent (var Event : TEvent);
  446.  
  447. function CalcHelpName : PathStr;
  448.  
  449. var
  450.  
  451.   EXEName : PathStr;
  452.   Dir : DirStr;
  453.   Name : NameStr;
  454.   Ext : ExtStr;
  455.  
  456. begin
  457.   if Lo (DosVersion) >= 3 then
  458.     EXEName := ParamStr (0)
  459.   else
  460.     EXEName := FSearch (appExeName, GetEnv ('PATH'));
  461.   FSplit (EXEName, Dir, Name, Ext);
  462.   if Dir[Length (Dir)] = '\' then
  463.     Dec (Dir[0]);
  464.   CalcHelpName := FSearch (appHelpName, Dir);
  465. end;
  466.  
  467. var
  468.  
  469.   W : PWindow;
  470.   HFile : PHelpFile;
  471.   HelpStrm : PDosStream;
  472.  
  473. begin
  474.   inherited GetEvent (Event);
  475.   case Event.What of
  476.     evCommand:
  477.       if (Event.Command = cmHelp) and (AppOptions and appHelpInUse = 0) then
  478.       begin {process help command if not in use}
  479.         AppOptions := AppOptions or appHelpInUse; {help's in use}
  480.         HelpStrm := New (PDosStream, Init (CalcHelpName, stOpenRead));
  481.         HFile := New (PHelpFile, Init (HelpStrm));
  482.         if HelpStrm^.Status <> stOk then
  483.         begin
  484.           MessageBox (#3'Could not open help file.', nil, mfError + mfOkButton);
  485.           Dispose (HFile, Done);
  486.         end
  487.         else
  488.         begin
  489.           W := New (PHelpWindow,Init (HFile, GetHelpCtx));
  490.           if ValidView (W) <> nil then
  491.           begin
  492.             DisableCommands ([cmHelp]);
  493.             ExecView (W);
  494.             Dispose (W, Done);
  495.             EnableCommands ([cmHelp])
  496.           end;
  497.           ClearEvent (Event)
  498.         end;
  499.         AppOptions := AppOptions and not appHelpInUse
  500.       end;
  501.     evMouseDown:
  502.       if Event.Buttons <> 1 then
  503.         Event.What := evNothing
  504.   end
  505. end;
  506.  
  507. {
  508. Get custom app palette.
  509. }
  510.  
  511. function TCyberGame.GetPalette: PPalette;
  512.  
  513. const
  514.  
  515.   CNewColor = CAppColor+CHelpColor+CAniColor+CGraphColor+CSysColor;
  516.   CNewBlackWhite = CAppBlackWhite+CHelpBlackWhite+CAniColor+CGraphColor+CSysColor;
  517.   CNewMonochrome = CAppMonochrome+CHelpMonochrome+CAniColor+CGraphColor+CSysColor;
  518.   P: array[apColor..apMonochrome] of string[Length (CNewColor)] =
  519.   (CNewColor, CNewBlackWhite, CNewMonochrome);
  520.  
  521. begin {add additional entries to the normal application palettes}
  522.   GetPalette := @P[AppPalette];
  523. end;
  524.  
  525. {
  526. Process app events.
  527. }
  528.  
  529. procedure TCyberGame.HandleEvent (var Event: TEvent);
  530.  
  531. {
  532. Load CGF file and store in table.
  533. }
  534.  
  535. procedure LoadChrFile (F : PathStr; ChrTbl : byte);
  536.  
  537. var
  538.  
  539.   ChrFile : TChrGenFile;
  540.  
  541. begin
  542.   ChrFile.Init;
  543.   ChrFile.OpenRead (F);
  544.   if (ChrFile.IoError = 0) and
  545.   (ChrFile.Header.Height = DefChrHeight) then
  546.   begin
  547.     ChrFile.ReadChrTable;
  548.     LoadFontTable (
  549.     ChrFile.ChrTablePtr,ChrTbl,ChrFile.Header.Height,
  550.     ChrFile.Header.StartChr,ChrFile.Header.TotalChrs)
  551.   end
  552.   else
  553.     MessageBox (#3'Problem reading font file.',nil,mfOkButton+mfError);
  554.   ChrFile.FreeChrTable;
  555.   ChrFile.Done
  556. end;
  557.  
  558. {
  559. Tree window.
  560. }
  561.  
  562. procedure TreeWindow (T : string; FMask : PathStr; ACmd : word);
  563.  
  564. var
  565.  
  566.   W : PDirWindow;
  567.   Drive : PathStr;
  568.  
  569. begin
  570.   GetDir (0,Drive);
  571.   W := New (PDirWindow,Init (T,Drive,FMask,ACmd));
  572.   W^.HelpCtx := hcTreeWindow;
  573.   InsertWindow (W)
  574. end;
  575.  
  576. {
  577. Return focused file name from dir tree window.  If the extension param is not
  578. null then that extension is used.
  579. }
  580.  
  581. function TreeFileName (TW : PDirWindow; EStr : PathStr; ReadFlag : boolean) : PathStr;
  582.  
  583. var
  584.  
  585.   F : file;
  586.   FName : PathStr;
  587.  
  588. begin
  589.   FName := UpCaseStr (TW^.FocDirName+TW^.NameLine^.Data^);
  590.   if (EStr <> '') and (FName[byte (FName[0])] <> '\') then {force extension}
  591.     FName := AddExtStr (FName,EStr);
  592.   if ReadFlag then
  593.     TreeFileName := FName
  594.   else
  595.   begin
  596.     Assign (F,FName);
  597.     {$I-} Reset (F); {$I+}
  598.     if IoResult = 0 then {see if file exists before writes}
  599.     begin
  600.       {$I-} Close (F); {$I+}
  601.       if MessageBox (FName+' already exists.  Erase and continue?',
  602.       nil,mfConfirmation or mfYesNoCancel) = cmYes then
  603.         TreeFileName := FName
  604.       else
  605.         TreeFileName := ''
  606.     end
  607.     else
  608.       TreeFileName := FName {doesn't exist, so return name}
  609.   end
  610. end;
  611.  
  612. {
  613. Load CGF file.
  614. }
  615.  
  616. procedure LoadFontFile (TW : PDirWindow);
  617.  
  618. var
  619.  
  620.   F : PathStr;
  621.  
  622. begin
  623.   F := TreeFileName (TW,'CGF',true);
  624.   if F <> '' then
  625.     LoadChrFile (F,FontTable1)
  626. end;
  627.  
  628. {
  629. Decode and view 2 color PCX file up to 640 X 480.  Actual viewing area is
  630. determined by graphics window size.
  631. }
  632.  
  633. procedure LoadPCXFile (TW : PDirWindow);
  634.  
  635. var
  636.  
  637.   F : PathStr;
  638.   Decode : TPCXToChrTable;
  639.  
  640. begin
  641.   F := TreeFileName (TW,'PCX',true);
  642.   if F <> '' then
  643.   begin
  644.     HideMouse; {no screen writes during font mem access}
  645.     Decode.Init (F,appGraphWinX,appGraphWinY,
  646.     DefChrHeight,vgaChrTableLoc[FontTable2]);
  647.     ShowMouse;
  648.     if Decode.ReadError <> 0 then
  649.       MessageBox (#3'Problem reading PCX file.',nil,mfOkButton+mfError);
  650.     Decode.Done
  651.   end
  652. end;
  653.  
  654. {
  655. Load DOC file.
  656. }
  657.  
  658. procedure ViewTextFile (FileName : PathStr);
  659.  
  660. var
  661.  
  662.   T : PTextWindow;
  663.   R : TRect;
  664.  
  665. begin
  666.   GetExtent (R);
  667.   R.Grow (-5,-4);
  668.   T := New(PTextWindow, Init(R, FileName));
  669.   T^.Options := T^.Options or ofCentered;
  670.   T^.HelpCtx := hcViewDoc;
  671.   InsertWindow (T)
  672. end;
  673.  
  674. {
  675. Create new game dialog.
  676. }
  677.  
  678. procedure GameDialog;
  679.  
  680. var
  681.  
  682.   P : PGameDlg;
  683.  
  684. begin
  685.   with CtlData do
  686.   begin
  687.     P := New (PGameDlg,Init ('Cyber Invaders',Left[1],Right[1],Shoot[1],Stop[1]));
  688.     if SoundFlag <> 0 then
  689.       P^.gameState := P^.gameState or gameSoundOn
  690.   end;
  691.   P^.HelpCtx := hcGameDialog;
  692.   InsertWindow (P)
  693. end;
  694.  
  695. {
  696. Restore default font loaded by config.
  697. }
  698.  
  699. procedure RestoreDefFont;
  700.  
  701. begin
  702.   if (DefFont <> nil) and
  703.   (DefChrHeight = BiosGetChrHeight) then
  704.     LoadFontTable (DefFont,FontTable1,DefChrHeight,0,vgaMaxChrs)
  705. end;
  706.  
  707. {
  708. Set custom screen options.
  709. }
  710.  
  711. procedure ScreenOptions;
  712.  
  713. var
  714.  
  715.   D : PScrOptsDlg;
  716.  
  717. begin
  718.   with ScrData do
  719.   begin
  720.     SMode := AppOptions and appScrOpts; {use only screen options}
  721.     FontMapVal (GetSeqCont (vgaSeqChrMapSel),byte (FntTbl1),byte (FntTbl2));
  722.     FChr := IntToStr (FirstChr);
  723.     LChr := IntToStr (LastChr);
  724.     D := New (PScrOptsDlg,Init);
  725.     D^.Options := D^.Options or ofCentered;
  726.     D^.HelpCtx := hcScreenDialog;
  727.     if ExecuteDialog (D,@ScrData) <> cmCancel then
  728.     begin
  729.       AppOptions := (AppOptions and not appScrOpts)
  730.       or SMode; {clear all scr opts bits and set bits returned from dialog}
  731.       FontTable1 := FntTbl1;
  732.       FontTable2 := FntTbl2;
  733.       FirstChr := StrToInt (FChr);
  734.       LastChr := StrToInt (LChr);
  735.       SetCustomScreen {set screen with new settings}
  736.     end
  737.   end
  738. end;
  739.  
  740. {
  741. Game keyboard controls and sound toggle.
  742. }
  743.  
  744. procedure ControlOptions;
  745.  
  746. var
  747.  
  748.   D : PGameOptsDlg;
  749.  
  750. begin
  751.   D := New (PGameOptsDlg,Init);
  752.   D^.Options := D^.Options or ofCentered;
  753.   D^.HelpCtx := hcControlsDialog;
  754.   ExecuteDialog (D,@CtlData)
  755. end;
  756.  
  757. {
  758. Set custom TV color palette.
  759. }
  760.  
  761. procedure Colors;
  762.  
  763. {custom color items}
  764. function DlgColorItems (Palette: Word; const Next: PColorItem) : PColorItem;
  765.  
  766. const
  767.  
  768.   COffset : array[dpBlueDialog..dpGrayDialog] of Byte = (64, 96, 32);
  769.  
  770. var
  771.  
  772.   Offset : Byte;
  773.  
  774. begin
  775.   Offset := COffset[Palette];
  776.   DlgColorItems :=
  777.     ColorItem ('Frame passive',     Offset,
  778.     ColorItem ('Frame active',      Offset + 1,
  779.     ColorItem ('Frame icons',       Offset + 2,
  780.     ColorItem ('Scroll bar page',   Offset + 3,
  781.     ColorItem ('Scroll bar icons',  Offset + 4,
  782.     ColorItem ('Static text',       Offset + 5,
  783.  
  784.     ColorItem ('Label normal',      Offset + 6,
  785.     ColorItem ('Label selected',    Offset + 7,
  786.     ColorItem ('Label shortcut',    Offset + 8,
  787.  
  788.     ColorItem ('Button normal',     Offset + 9,
  789.     ColorItem ('Button default',    Offset + 10,
  790.     ColorItem ('Button selected',   Offset + 11,
  791.     ColorItem ('Button disabled',   Offset + 12,
  792.     ColorItem ('Button shortcut',   Offset + 13,
  793.     ColorItem ('Button shadow',     Offset + 14,
  794.  
  795.     ColorItem ('Cluster normal',    Offset + 15,
  796.     ColorItem ('Cluster selected',  Offset + 16,
  797.     ColorItem ('Cluster shortcut',  Offset + 17,
  798.  
  799.     ColorItem ('Input normal',      Offset + 18,
  800.     ColorItem ('Input selected',    Offset + 19,
  801.     ColorItem ('Input arrow',       Offset + 20,
  802.  
  803.     ColorItem ('History button',    Offset + 21,
  804.     ColorItem ('History sides',     Offset + 22,
  805.     ColorItem ('History bar page',  Offset + 23,
  806.     ColorItem ('History bar icons', Offset + 24,
  807.  
  808.     ColorItem ('List normal',       Offset + 25,
  809.     ColorItem ('List focused',      Offset + 26,
  810.     ColorItem ('List selected',     Offset + 27,
  811.     ColorItem ('List divider',      Offset + 28,
  812.  
  813.     ColorItem('Information pane',  Offset + 29,
  814.     Next))))))))))))))))))))))))))))));
  815. end;
  816.  
  817. function HelpColorItems(const Next: PColorItem): PColorItem;
  818.  
  819. begin
  820.   HelpColorItems :=
  821.     ColorItem ('Frame passive',     128,
  822.     ColorItem ('Frame active',      129,
  823.     ColorItem ('Frame icons',       130,
  824.     ColorItem ('Scroll bar page',   131,
  825.     ColorItem ('Scroll bar icons',  132,
  826.     ColorItem ('Normal text',       133,
  827.     ColorItem ('Key word',          134,
  828.     ColorItem ('Select key word',   135,
  829.     Next))))))))
  830. end;
  831.  
  832. function AniColorItems (const Next: PColorItem) : PColorItem;
  833.  
  834. begin
  835.   AniColorItems :=
  836.     ColorItem ('Background',       136,
  837.     ColorItem ('Invaders',         137,
  838.     ColorItem ('UFO',              138,
  839.     ColorItem ('UFO bomb',         139,
  840.     ColorItem ('UFO bomb explode', 140,
  841.     ColorItem ('Base ship',        141,
  842.     ColorItem ('Base ship shot',   142,
  843.     ColorItem ('PCX graphics',     143,
  844.     Next))))))))
  845. end;
  846.  
  847. function SysColorItems (const Next: PColorItem) : PColorItem;
  848.  
  849. begin
  850.   SysColorItems :=
  851.     ColorItem ('Shadow',       144,
  852.     ColorItem ('System error', 145,
  853.     ColorItem ('Index error',  146,
  854.     Next)))
  855. end;
  856.  
  857. var
  858.  
  859.   D : PColorDialog;
  860.  
  861. begin
  862.   D := New (PColorDialog,Init ('',
  863.   ColorGroup ('Desktop',     DesktopColorItems(nil),
  864.   ColorGroup ('Menus',       MenuColorItems(nil),
  865.   ColorGroup ('Gray Windows',WindowColorItems(wpGrayWindow,nil),
  866.   ColorGroup ('Blue Windows',WindowColorItems(wpBlueWindow,nil),
  867.   ColorGroup ('Cyan Windows',WindowColorItems(wpCyanWindow,nil),
  868.   ColorGroup ('Gray Dialogs',DlgColorItems(dpGrayDialog,nil),
  869.   ColorGroup ('Blue Dialogs',DlgColorItems(dpBlueDialog,nil),
  870.   ColorGroup ('Cyan Dialogs',DlgColorItems(dpCyanDialog,nil),
  871.   ColorGroup ('Help',        HelpColorItems(nil),
  872.   ColorGroup ('Animation',   AniColorItems(nil),
  873.   ColorGroup ('System',      SysColorItems(nil),
  874.   nil)))))))))))));
  875.   D^.HelpCtx := hcColorDialog;
  876.   if ExecuteDialog (D,Application^.GetPalette) <> cmCancel then
  877.   begin
  878.     DoneMemory; {dispose all group buffers}
  879.     ReDraw;     {redraw application with new palette}
  880.     ShadowAttr := GetColor (144);   {tv shadow color}
  881.     SysColorAttr := (GetColor (145) shl 8) or GetColor (145); {tv system error color}
  882.     ErrorAttr := GetColor (146)     {tv palette index error color}
  883.   end
  884. end;
  885.  
  886. {
  887. Adjust 16 text colors at DAC level.
  888. }
  889.  
  890. procedure AdjustPalette;
  891.  
  892. var
  893.  
  894.   D : PPalDlg;
  895.  
  896. begin
  897.   D := New (PPalDlg,Init);
  898.   D^.Options := D^.Options or ofCentered;
  899.   D^.HelpCtx := hcPaletteDialog;
  900.   if ExecuteDialog (D,nil) <> cmCancel then
  901.     GetDACBlock (@DacPalette,0,256)
  902. end;
  903.  
  904. {
  905. Load .CFG file.
  906. }
  907.  
  908. procedure LoadConfigFile (TW : PDirWindow);
  909.  
  910. var
  911.  
  912.   F : PathStr;
  913.  
  914. begin
  915.   F := TreeFileName (TW,'CFG',true);
  916.   if F <> '' then
  917.     RestoreDeskTop (F)
  918. end;
  919.  
  920. {
  921. Save .CFG file.
  922. }
  923.  
  924. procedure SaveConfigFile (TW : PDirWindow);
  925.  
  926. var
  927.  
  928.   F : PathStr;
  929.  
  930. begin
  931.   F := TreeFileName (TW,'CFG',false);
  932.   if F <> '' then
  933.     SaveDeskTop (F)
  934. end;
  935.  
  936. {
  937. Force all oftileable windows to top.
  938. }
  939.  
  940. procedure TileableOnTop (P : PView); far;
  941.  
  942. begin
  943.   if (P^.Options and ofTileable = ofTileable) then
  944.     P^.MakeFirst
  945. end;
  946.  
  947. begin
  948.   if (Event.What = evCommand) and
  949.   ((Event.Command = cmCascade) or
  950.   (Event.Command = cmTile)) then {seperate oftileable windows from nontileable ones}
  951.     Desktop^.ForEach (@TileableOnTop);
  952.   inherited HandleEvent (Event);
  953.   case Event.What of
  954.     evCommand:
  955.       begin
  956.         case Event.Command of {process commands}
  957.           cmLoadFont    : TreeWindow ('Load Font File','*.CGF',cmLoadFont);
  958.           cmLoadPCX     : TreeWindow ('Load PCX File','*.PCX',cmLoadPCX);
  959.           cmSaveConfig  : TreeWindow ('Save Config Stream','*.CFG',cmSaveConfig);
  960.           cmLoadConfig  : TreeWindow ('Load Config Stream','*.CFG',cmLoadConfig);
  961.           cmViewDoc     : ViewTextFile (appDocName);
  962.           cmAbout       : AboutBox;
  963.           cmNewGame     : GameDialog;
  964.           cmCloseAll    : ClearDeskTop;
  965.           cmRestoreDef  : RestoreDefFont;
  966.           cmScreenOpts  : ScreenOptions;
  967.           cmControlOpts : ControlOptions;
  968.           cmColors      : Colors;
  969.           cmAdjPal      : AdjustPalette
  970.         else
  971.           Exit
  972.         end
  973.       end;
  974.     evBroadcast :
  975.     begin
  976.       case Event.Command of {process broadcasts}
  977.         cmLoadFont    : LoadFontFile (PDirWindow (Event.InfoPtr));
  978.         cmLoadPCX     : LoadPCXFile (PDirWindow (Event.InfoPtr));
  979.         cmSaveConfig  : SaveConfigFile (PDirWindow (Event.InfoPtr));
  980.         cmLoadConfig  : LoadConfigFile (PDirWindow (Event.InfoPtr))
  981.       end
  982.     end
  983.   end
  984. end;
  985.  
  986. {
  987. Assign desk top pattern char, page locations, set default char height from
  988. bios and save current DAC palette.
  989. }
  990.  
  991. procedure TCyberGame.InitDeskTop;
  992.  
  993. begin
  994.   SetScreenMode (smCO80);              {make sure 80x25 active}
  995.   inherited InitDeskTop;
  996.   DeskTop^.Background^.Pattern := '▓'; {new wall paper}
  997.   Page := vgaPageLoc[1];
  998.   PageOfs := vgaPageOfsLoc[1];
  999.   DefChrHeight := BiosGetChrHeight;
  1000.   GetDACBlock (@DacPalette,0,256)      {save current vga palette}
  1001. end;
  1002.  
  1003. {
  1004. Menu.
  1005. }
  1006.  
  1007. procedure TCyberGame.InitMenuBar;
  1008.  
  1009. var
  1010.  
  1011.   R : TRect;
  1012.  
  1013. begin
  1014.   GetExtent (R);
  1015.   R.B.Y := R.A.Y+1;
  1016.   MenuBar := New (PMenuBar,Init (R,NewMenu (
  1017.     NewSubMenu ('~F~ile',hcFile,NewMenu (
  1018.     NewSubMenu ('~L~oad',hcLoadFile,NewMenu (
  1019.       NewItem ('~F~ont...','F3',kbF3,cmLoadFont,hcLoadFile,
  1020.       NewItem ('~P~CX...','Shift+F3',kbShiftF3,cmLoadPCX,hcLoadFile,
  1021.       NewItem ('~C~onfig...','Ctrl+F3',kbCtrlF3,cmLoadConfig,hcLoadFile,
  1022.       nil)))),
  1023.       NewItem ('~S~ave config...','Ctrl+F2',kbCtrlF2,cmSaveConfig,hcSaveFile,
  1024.       NewLine (
  1025.       NewItem ('~V~iew doc','',kbNoKey,cmViewDoc,hcViewDoc,
  1026.       NewItem ('~A~bout','',kbNoKey,cmAbout,hcAbout,
  1027.       NewLine (
  1028.       NewItem ('E~x~it','Alt+X',kbAltX,cmQuit,hcExit,
  1029.       nil)))))))),
  1030.     NewSubMenu('~W~indow',hcWindows,NewMenu(
  1031.       StdWindowMenuItems(
  1032.       NewItem ('~N~ew game','F7',kbF7,cmNewGame,hcNewGame,
  1033.       nil))),
  1034.     NewSubMenu ('~O~ptions',hcOptions,NewMenu (
  1035.       NewItem ('~S~creen...','',kbNoKey,cmScreenOpts,hcScreen,
  1036.       NewItem ('~C~olors...','',kbNoKey,cmColors,hcOColors,
  1037.       NewItem ('~A~djust palette...','',kbNoKey,cmAdjPal,hcAdjustPalette,
  1038.       NewItem ('~D~efault font','F4',kbNoKey,cmRestoreDef,hcDefaultFont,
  1039.       NewItem ('~G~ame controls...','Alt+G',kbNoKey,cmControlOpts,hcControls,
  1040.       nil)))))),nil))))))
  1041. end;
  1042.  
  1043. {
  1044. Status line.
  1045. }
  1046.  
  1047. procedure TCyberGame.InitStatusLine;
  1048.  
  1049. var
  1050.  
  1051.   R : TRect;
  1052.  
  1053. begin
  1054.   GetExtent (R);
  1055.   R.A.Y := R.B.Y-1;
  1056.   StatusLine := New (PStatusLine,Init(R,
  1057.     NewStatusDef (0,$FFFF,
  1058.       NewStatusKey ('~F1~ Help', kbF1, cmHelp,
  1059.       NewStatusKey ('~Alt+F3~ Close',kbAltF3,cmClose,
  1060.       NewStatusKey ('~Alt+X~ Exit',kbAltX,cmQuit,
  1061.       NewStatusKey ('',kbAltG,cmControlOpts,
  1062.       NewStatusKey ('',kbF4,cmRestoreDef,
  1063.       NewStatusKey ('',kbF3,cmLoadFont,
  1064.       NewStatusKey ('',kbShiftF3,cmLoadPCX,
  1065.       NewStatusKey ('',kbCtrlF2,cmSaveConfig,
  1066.       NewStatusKey ('',kbCtrlF3,cmLoadConfig,
  1067.       NewStatusKey ('',kbCtrlF5,cmResize,
  1068.       NewStatusKey ('',kbF10,cmMenu,
  1069.       nil))))))))))),nil)))
  1070. end;
  1071.  
  1072. {
  1073. Message when safety pool is cut into.
  1074. }
  1075.  
  1076. procedure TCyberGame.OutOfMemory;
  1077.  
  1078. begin
  1079.   MessageBox (#3'Not enough memory available to complete operation.  Try closing some windows!',
  1080.   nil,mfError+mfOkButton)
  1081. end;
  1082.  
  1083. {
  1084. Load desk top from stream.
  1085. }
  1086.  
  1087. procedure TCyberGame.LoadDesktop (var S : TStream);
  1088.  
  1089. var
  1090.  
  1091.   Pal : PString;
  1092.  
  1093. begin
  1094.   Pal := S.ReadStr;
  1095.   if Pal <> nil then
  1096.   begin
  1097.     Application^.GetPalette^ := Pal^;
  1098.     DoneMemory;
  1099.     DisposeStr (Pal)
  1100.   end
  1101. end;
  1102.  
  1103. {
  1104. Store desk top on stream.
  1105. }
  1106.  
  1107. procedure TCyberGame.StoreDesktop(var S: TStream);
  1108.  
  1109. var
  1110.  
  1111.   Pal: PString;
  1112.  
  1113. begin
  1114.   Pal := @Application^.GetPalette^;
  1115.   S.WriteStr (Pal)
  1116. end;
  1117.  
  1118. {
  1119. If VGA is present then start TV app else print error message.
  1120. }
  1121.  
  1122. var
  1123.  
  1124.   CFApp : TCyberGame;
  1125.  
  1126. begin
  1127.   if VGACardActive then
  1128.   begin
  1129.     CFApp.Init;
  1130.     SysErrorFunc := AppSystemError;
  1131.     CFApp.Run;
  1132.     CFApp.Done
  1133.   end
  1134.   else
  1135.     PrintStr (#13#10'VGA display required to run CyberGame!'#13#10);
  1136. end.
  1137.